with Ada.Exceptions; use Ada.Exceptions;
with Ada.Numerics.Discrete_Random; use Ada.Numerics;
with Ada.Text_IO; use Ada.Text_IO;
with Queue_Pack_Protected_Generic;
with Sync_Type;
procedure Pipelined_Insersort is
No_of_Nodes : constant Positive := 10;
Data_Stream_Length : constant Positive := 10_000;
type Element is range 100 .. 999;
type Maybe_Element (Valid : Boolean := False) is
record
case Valid is
when True => Value : Element;
when False => null;
end case;
end record;
function Invalid_Element return Maybe_Element is ((Valid => False));
function Valid_Element (E : Element) return Maybe_Element is ((Valid => True, Value => E));
package Random_Element is new Discrete_Random (Result_Subtype => Element);
use Random_Element;
Element_Generator : Generator;
package Element_Queue is new Queue_Pack_Protected_Generic (Element => Element,
Size => Data_Stream_Length);
Result_Queue : Element_Queue.Protected_Queue;
type Node;
type Node_Access is access all Node;
task type Node is
entry Link (Next_Node : Node_Access);
entry Feed (E : Maybe_Element);
end Node;
task body Node is
Next : Node_Access := null;
Node_Size : constant Positive := (Data_Stream_Length + No_of_Nodes - 1) / No_of_Nodes;
package Maybe_Element_Queue is new Queue_Pack_Protected_Generic (Element => Maybe_Element,
Size => Node_Size);
Queue : Maybe_Element_Queue.Protected_Queue;
package Sync_Maybe_Element is new Sync_Type (Element => Maybe_Element,
Default => Invalid_Element);
Max_Element : Sync_Maybe_Element.Protect;
task Insert_Elements;
task body Insert_Elements is
subtype Data_Length is Natural range 0 .. Node_Size;
subtype Data_Index is Natural range 1 .. Node_Size;
subtype Data_Index_Ext is Natural range 1 .. Node_Size + 1;
No_of_Elements : Data_Length := 0;
Data : array (Data_Index) of Element := (others => Element'Invalid_Value);
function Pipeline_Filled return Boolean is (No_of_Elements = Node_Size);
begin
Insert_Elements_Loop : loop
declare
Item : Maybe_Element := Invalid_Element;
begin
Queue.Dequeue (Item);
if Item.Valid then
declare
Spot : Data_Index_Ext := Data_Index_Ext'First;
begin
while Spot <= No_of_Elements and then Data (Spot) < Item.Value loop
Spot := Spot + 1;
end loop;
if Pipeline_Filled and then Spot > No_of_Elements then
Next.all.Feed (Item);
else
if Pipeline_Filled then
Next.all.Feed (Valid_Element (Data (No_of_Elements)));
else
No_of_Elements := No_of_Elements + 1;
end if;
Data (Spot + 1 .. No_of_Elements) := Data (Spot .. No_of_Elements - 1);
Data (Spot) := Item.Value;
end if;
end;
if Pipeline_Filled then
Max_Element.Set (Valid_Element (Data (No_of_Elements)));
end if;
else
Put_Line ("Node reports" & Data_Length'Image (No_of_Elements) & " values from" & Element'Image (Data (Data'First)) & " to" & Element'Image (Data (No_of_Elements)));
for e of Data (Data'First .. No_of_Elements) loop
Result_Queue.Enqueue (e);
end loop;
if Next /= null then
Next.all.Feed (Item);
end if;
exit Insert_Elements_Loop;
end if;
end;
end loop Insert_Elements_Loop;
exception
when E : others => Put_Line (Exception_Information (E));
end Insert_Elements;
Node_Active : Boolean := True;
begin
accept Link (Next_Node : Node_Access) do
Next := Next_Node;
end Link;
while Node_Active loop
accept Feed (E : Maybe_Element) do
if E.Valid and then Max_Element.Get.Valid and then E.Value >= Max_Element.Get.Value then
Next.all.Feed (E);
else
Queue.Enqueue (E);
end if;
Node_Active := E.Valid;
end Feed;
end loop;
exception
when E : others => Put_Line (Exception_Information (E));
end Node;
Nodes : array (1 .. No_of_Nodes) of aliased Node;
begin
Put_Line ("--- Providing nodes with next-node link");
for n in Nodes'First .. Nodes'Last - 1 loop
Nodes (n).Link (Nodes (n + 1)'Access);
end loop;
Nodes (Nodes'Last).Link (null);
Put_Line ("--- Feeding in" & Positive'Image (Data_Stream_Length) & " random elements");
Reset (Element_Generator);
for i in 1 .. Data_Stream_Length loop
Nodes (Nodes'First).Feed (Valid_Element (Random (Element_Generator)));
end loop;
Put_Line ("--- Feeding in end of data stream token");
Nodes (Nodes'First).Feed (Invalid_Element);
declare
Prior_Result, Result : Element := Element'Invalid_Value;
begin
Result_Queue.Dequeue (Prior_Result);
for i in 1 .. Data_Stream_Length - 1 loop
Result_Queue.Dequeue (Result);
if Prior_Result > Result then
raise Program_Error with "Found out of order elements";
end if;
Prior_Result := Result;
end loop;
end;
Put_Line ("--- Terminated with an ordered list");
end Pipelined_Insersort;